home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
pcfig4th.zip
/
SCREENED.SCR
< prev
next >
Wrap
Text File
|
1985-04-23
|
35KB
|
1 lines
KEY: DESCRIPTION: --------- ------------------------------------------------^E/^X MOVE cursor up/down 1 line CR MOVE to beginning of next line ( or insert CR ) ^S,^H/^D MOVE cursor left/right 1 column ^A/^F MOVE cursor left/right one word ^I,TAB MOVE/INSERT 8 spaces right ^R MOVE cursor up 4 lines ^G/^T DELETE char/word right DEL DELETE char left ^Y/^B/^K DELETE line/line contents/screen contents ^Z ABANDON edited screen ^V TOGGLE insert mode/overstrike mode ESC EXIT editor and update changes ( FORTH SCREEN EDITOR: SED ) --> This editor is a slightly modified version of Henry Laxen's editor which appeared in Dr. Dobb's Journal, No. 59 (9/81). Operation is very simple; the reference above describes all the functions more completely. While a lot of effort has gone into handling the ^C interrupt, it still blows up regularly. You are much better off using the editor with FORTH assembled under the _DIRECTCON i/o option. The major changes are: ...The editor uses a range of screens. The up and down cursor keys can be used to quickly move over any number of screens. Screen display is preempted if you go fast. ...Edited screens are automatically saved on disk. ...While in insert mode, the TAB and CR actually insert. In overstrike mode, they just move the cursor. ( SED: utilities: \, DEPTH, BOUNDS, BEEP ) : \ ( -- ; comment to end of line ) IN @ C/L / 1+ C/L * IN ! ; IMMEDIATE : DEPTH ( -- n ; stack depth ) SP@ S0 @ SWAP - 2 / 0 MAX ; : BOUNDS ( addr l -- addr1 addr2 ; set-up for DO-LOOP ) OVER + SWAP ; : BEEP 07 EMIT ; --> ( SED: backward move: <CMOVE ) : <CMOVE ( from to n -- ; CMOVE high to low ) -DUP IF >R R + 1- SWAP 1- R> BOUNDS SWAP DO I C@ OVER C! 1- -1 +LOOP DROP ELSE DROP DROP ENDIF ; --> ( SED: utilities: MOVE, CASE:, -TIDY ) : MOVE ( from to n -- ; smart move ) ROT ROT 2DUP U< IF ( move down ) ROT <CMOVE ELSE ( move up ) ROT CMOVE THEN ; : CASE: ( n -- ; indexed case statement ) <BUILDS ] SMUDGE DOES> SWAP DUP + + @ EXECUTE ; : -TIDY ( addr n -- ;clears control chars in range ) BOUNDS DO I C@ BL < IF BL I C! THEN LOOP ; --> ( SED: variables and constants ) VOCABULARY EDITOR IMMEDIATE EDITOR DEFINITIONS ( add to line editor ) 0 VARIABLE &MODE ( insert/overstrike flag ) 0 VARIABLE &CURSOR ( current cursor location 0-1023 ) 0 VARIABLE &OLD-MODE ( used to check for mode changes ) 0 VARIABLE &UPDATE ( TRUE if screen has been changed ) 0 VARIABLE &BUF-ADR ( address of buffer being edited ) 0 VARIABLE &TICKS ( count of keystrokes ) 0 VARIABLE &E-ID ( user ID$ ) 12 ALLOT &E-ID 14 BLANKS 5 CONSTANT X-OFF ( offset column for display ) 2 CONSTANT Y-OFF ( offset row ) 120 CONSTANT AUTO ( ticks to count before update ) --> ( SED: terminal functions ) ' NOOP CFA DUP DUP VARIABLE 'PLACE VARIABLE 'PAGE VARIABLE '-EOL : PLACE ( col row -- ; place cursor at row, column ) 'PLACE @ EXECUTE ; : PAGE ( -- ;clear screen ) 'PAGE @ EXECUTE ; : -EOL ( -- ;clear to end of line ) '-EOL @ EXECUTE ; --> ( SED: +CURPOS, MOVE-CURSOR, >LINE#, LINE#> ) : +CURPOS ( n -- ;adjust cursor position by n ) &CURSOR +! ( &CURSOR @ 0 MAX 1023 MIN &CURSOR ! ) ; : MOVE-CURSOR ( n -- ;move cursor n places on screen ) +CURPOS &CURSOR @ C/L /MOD Y-OFF + SWAP X-OFF + SWAP PLACE ; : >LINE# C/L / ; ( pos -- n; convert pos to line number ) : LINE#> C/L * ; ( n -- pos ;convert line number to pos ) --> ( SED: POS>>ADR, BUF-MOVE, ?PRINTABLE, CHARS-TO-EOL ) : POS>>ADR ( pos -- addr; converts cursor pos to buffer addr ) &BUF-ADR @ + ; : BUF-MOVE ( from to n -- ;moves text in buffer ) ROT POS>>ADR ROT POS>>ADR ROT MOVE 1 &UPDATE ! ; : ?PRINTABLE ( c -- f; TRUE if c is printing char ) DUP 32 < SWAP 126 > OR 0= ; : CHARS-TO-EOL ( pos -- n ;returns number of chars after pos ) C/L MOD C/L SWAP - ; --> ( SED: DISPLAY-TO-EOL, EMPTY-LINE ) : DISPLAY-TO-EOL ( pos -- ;print line starting at pos ) DUP POS>>ADR OVER CHARS-TO-EOL -TRAILING ROT OVER + >R TYPE R> -EOL ; : ?EMPTY-LINE ( n -- f ;TRUE if line n all blanks ) LINE#> POS>>ADR C/L -TRAILING SWAP DROP 0= ; : DISPLAY-TO-EOS ( n -- ;show screen starting at line n ) &CURSOR @ SWAP 16 SWAP DO ?TERMINAL IF LEAVE THEN ( preempt scrolling ) I LINE#> DUP &CURSOR ! 0 MOVE-CURSOR DISPLAY-TO-EOL LOOP &CURSOR ! 0 MOVE-CURSOR ; --> ( SED: insert/delete lines: EXPAND, SHRINK ) : EXPAND ( pos -- ;insert a blank line at pos ) DUP DUP C/L + 1024 OVER - BUF-MOVE POS>>ADR C/L BLANKS 1 &UPDATE ! ; : SHRINK ( pos -- ;delete line at pos, make last line blank ) DUP C/L + SWAP OVER 1024 SWAP - BUF-MOVE 15 LINE#> POS>>ADR C/L BLANKS 1 &UPDATE ! ; --> ( SED: INSERT-LINE, DELETE-LINE ) : INSERT-LINE ( pos -- ;if there is room, insert line at pos ) 15 ?EMPTY-LINE IF DUP EXPAND >LINE# DISPLAY-TO-EOS ELSE BEEP THEN ; : DELETE-LINE ( pos -- ;delete current line ) >LINE# DUP LINE#> SHRINK DISPLAY-TO-EOS ; --> ( SED: insert/delete chars: INSERT-CHAR, DELETE-CHAR ) : INSERT-CHAR ( c pos -- ;insert char at pos ) DUP DUP 1+ OVER CHARS-TO-EOL 1- BUF-MOVE POS>>ADR C! ; : DELETE-CHAR ( pos -- ;delete char at pos ) DUP DUP 1+ SWAP OVER CHARS-TO-EOL BUF-MOVE DUP CHARS-TO-EOL + 1- POS>>ADR BL SWAP C! ; --> ( SED: arrow commands, I-LINE, D-LINE, D-CHAR ) : R-ARROW 1 +CURPOS ; : L-ARROW -1 +CURPOS ; : U-ARROW C/L MINUS +CURPOS ; : D-ARROW C/L +CURPOS ; : I-LINE &CURSOR @ INSERT-LINE ; : D-LINE &CURSOR @ DELETE-LINE ; : D-CHAR &CURSOR @ DELETE-CHAR &CURSOR @ DISPLAY-TO-EOL ; : INSERT-MODE &MODE 1 TOGGLE ; --> ( SED: RETURN, EXIT-EDIT ) : RETURN ( -- ;handles carriage return ) &MODE @ IF ( insert mode ) I-LINE THEN &CURSOR @ >LINE# 1+ 15 MIN LINE#> &CURSOR ! ; : EXIT-EDIT ( -- ;leave editor ) CR R> DROP R> DROP R> DROP R> DROP R> DROP R> DROP ; --> ( SED: EXIT-UPDATE ) : E-UPDATE ( -- ;exit editor, update screen if changed ) [ ' ABORT CFA ] LITERAL ' (ABORT) ! 0 WARNING ! 1024 MOVE-CURSOR CR CR SCR ? ( show current screen ) &UPDATE @ IF ( updated ) &E-ID [ C/L 10 - ] LITERAL &BUF-ADR @ + 10 CMOVE ." Modified " UPDATE SAVE-BUFFERS ." and saved" ELSE ." Unchanged " THEN ; : EXIT-UPDATE E-UPDATE EXIT-EDIT ; : EDIT-ABORT ( -- ;handle ^C as gracefully as possible ) ." ***ABORTED*** " E-UPDATE SP! QUIT ; --> ( SED: EXIT-SCRATCH, E-TAB ) : EXIT-SCRATCH ( -- ;exit editor, leave screen unchanged ) 1024 MOVE-CURSOR CR CR SCR ? ." Abandoned -- use UPDATE to save changes " EXIT-EDIT ; : E-TAB ( -- ;tab cursor ) 8 &CURSOR @ 8 MOD - &MODE @ ( modified so that TAB inserts ) IF ( insert mode ) DUP 0 DO BL &CURSOR @ INSERT-CHAR LOOP &CURSOR @ DISPLAY-TO-EOL THEN +CURPOS ; --> ( SED: scanning words: SCAN, <SCANBL, <SCAN-BL, etc ) ' = CFA VARIABLE BOOLOP ( Boolean function: n n -- f ) : <> = 0= ; : SCAN ( dir addr2 addr1 -- n ;scan addr1 to addr2 ) 2DUP = IF ( a1=a2 ) DROP DROP DROP 0 ELSE 0 ROT ROT DO I C@ BL BOOLOP @ EXECUTE ( = or <> ) IF ( match ) LEAVE ELSE OVER + THEN OVER +LOOP SWAP DROP THEN ; ( scan backwards or forward, for blank or not blank ) : <SCANBL [ ' = CFA ] LITERAL BOOLOP ! -1 ROT ROT SCAN ; : <SCAN-BL [ ' <> CFA ] LITERAL BOOLOP ! -1 ROT ROT SCAN ; : SCANBL> [ ' = CFA ] LITERAL BOOLOP ! 1 ROT ROT SCAN ; : SCAN-BL> [ ' <> CFA ] LITERAL BOOLOP ! 1 ROT ROT SCAN ; --> ( SED: word operations: MOVELW, MOVERW, D-WORD ) : MOVELW ( -- n ;move cursor left a word ) 0 POS>>ADR &CURSOR @ POS>>ADR <SCANBL >R 0 POS>>ADR &CURSOR @ POS>>ADR R + <SCAN-BL R> + >R 0 POS>>ADR &CURSOR @ POS>>ADR R + <SCANBL R> + DUP &CURSOR @ POS>>ADR + C@ BL = IF 1+ THEN ; : MOVERW ( -- n ;move cursor right a word ) 1023 POS>>ADR &CURSOR @ POS>>ADR SCANBL> >R 1023 POS>>ADR &CURSOR @ POS>>ADR R + SCAN-BL> R> + ; : L-WORD MOVELW +CURPOS ; : R-WORD MOVERW +CURPOS ; : DELETE-CHARS ( n pos -- ;delete n chars at pos ) 2DUP + OVER DUP CHARS-TO-EOL BUF-MOVE DUP CHARS-TO-EOL + OVER - POS>>ADR SWAP BLANKS ; : D-WORD ( -- ) MOVERW &CURSOR @ POS>>ADR &CURSOR @ CHARS-TO-EOL -TRAILING SWAP DROP MIN &CURSOR @ DELETE-CHARS &CURSOR @ DISPLAY-TO-EOL ; --> ( SED: U-TAB, D-TAB, CLR-SCREEN ) : U-TAB 4 C/L * MINUS +CURPOS ; : D-TAB 4 C/L * +CURPOS ; : CLR-SCREEN ( -- ;clear screen to all blanks ) 0 &CURSOR ! &BUF-ADR @ 1024 BLANKS 0 DISPLAY-TO-EOS 1 &UPDATE ! ; --> ( SED: automatic updating; TICK ) : TICK ( -- ;called at each KEY to trigger update ) 1 &TICKS @ + DUP &TICKS ! AUTO > IF ( time to update ) 50 0 PLACE ." updating..." 0 &TICKS ! SAVE-BUFFERS 50 0 PLACE -EOL THEN ; --> ( SED: DISPLAY-STATUS ) : DISPLAY-STATUS ( -- ;show current editing state ) &MODE @ &OLD-MODE @ = 0= IF ( mode has changed ) 40 0 PLACE &MODE @ IF ( insert on ) ." Insert ON" ELSE 9 SPACES THEN &MODE @ &OLD-MODE ! THEN &CURSOR @ C/L /MOD 20 0 PLACE 2 .R 33 0 PLACE 2 .R ; --> ( SED: CLR-LINE ) : CLR-LINE ( -- ;sets current line to blanks ) &CURSOR @ DUP >LINE# LINE#> &CURSOR ! &CURSOR @ POS>>ADR C/L BLANKS 1 &UPDATE ! 0 MOVE-CURSOR &CURSOR @ -EOL &CURSOR ! ; --> ( SED: GET-USER-ID ) : GET-USER-ID ( -- ;asks for ID if none current ) &E-ID 10 -TRAILING 0= IF ( no ID ) CR ." Enter your ID: " 10 0 DO 46 EMIT LOOP 10 0 DO 8 EMIT LOOP 10 EXPECT &E-ID 10 -TIDY ELSE DROP THEN ; --> ( SED: control character binding, ORIENT ) CASE: (CONTROL-CHAR) ( c -- ;executes function bound to c ) ( ^@) BEEP L-WORD CLR-LINE D-TAB R-ARROW U-ARROW R-WORD ( ^G) D-CHAR L-ARROW E-TAB BEEP CLR-SCREEN BEEP RETURN ( ^N) I-LINE BEEP BEEP BEEP U-TAB L-ARROW D-WORD BEEP ( ^V) INSERT-MODE BEEP D-ARROW D-LINE ( ^Z) EXIT-SCRATCH ( ESC) EXIT-UPDATE ; : ORIENT ( -- ;check for new screen, change if necessary ) &CURSOR @ DUP 0< OVER 1023 > OR IF ( new screen ) &UPDATE @ IF UPDATE 0 &UPDATE ! THEN 0< IF ( moving back ) 0 -1 ELSE [ 15 64 * ] LITERAL 1 THEN SCR +! &CURSOR ! SCR @ BLOCK &BUF-ADR ! 7 0 PLACE SCR @ 4 .R 0 DISPLAY-TO-EOS ( show it ) ELSE DROP THEN ; --> ( SED: CONTROL-CHAR ) ( modified to make DEL a destructive backspace ) : CONTROL-CHAR ( c -- ;process control char c ) DUP 127 = IF ( ASCII DEL ) DROP &CURSOR @ IF ( not at top left ) -1 MOVE-CURSOR 07 ( ^G ) ELSE 0 THEN THEN DUP 28 < IF ( bound key ) (CONTROL-CHAR) ORIENT ELSE DROP BEEP THEN ; --> ( SED: E-OVERSTRIKE, E-INSERT ) : E-OVERSTRIKE ( -- ;edit in overstrike mode ) KEY DUP ?PRINTABLE IF DUP EMIT &CURSOR @ POS>>ADR C! 1 &UPDATE ! 1 +CURPOS ELSE CONTROL-CHAR THEN ; : E-INSERT ( -- ;edit in insert mode ) KEY DUP ?PRINTABLE IF &CURSOR @ INSERT-CHAR &CURSOR @ DISPLAY-TO-EOL 1 +CURPOS ELSE CONTROL-CHAR THEN ; --> ( SED: E-INIT ) : E-INIT ( -- ;initialize the editor ) DEPTH IF SCR ! ENDIF SCR @ BLOCK &BUF-ADR ! GET-USER-ID PAGE 0 &MODE ! 0 &CURSOR ! 0 &UPDATE ! 0 &TICKS ! ' EDIT-ABORT CFA ' (ABORT) ! -1 WARNING ! ( catch ^C ) 0 Y-OFF PLACE 16 0 DO I 3 .R CR LOOP ( print line no's. ) 0 0 PLACE ." Screen: " 6 SPACES ." line: column: " 7 0 PLACE SCR @ 4 .R 0 DISPLAY-TO-EOS ; ( and the text ) --> ( SED ) : SED ( [n] -- ;begin editing screen n ) EDITOR E-INIT BEGIN TICK DISPLAY-STATUS 0 MOVE-CURSOR &MODE @ IF ( insert mode ) E-INSERT ELSE E-OVERSTRIKE THEN AGAIN ; CR CR ." Screen editor ready, configured for " : ESC 27 EMIT ; --> ( SED : TV-950 terminal functions ) ( uncomment the arrow to select another terminal --> ) ." Televideo 950 terminal" CR CR : TV-PLACE ESC 61 EMIT 32 + EMIT 32 + EMIT ; ( ESC '=' r, c ) : TV-PAGE 0 0 TV-PLACE ESC 89 EMIT ; ( ESC 'Y' ) : TV-EOL DROP ESC 84 EMIT ; ( ESC 'T' ) ' TV-PLACE CFA 'PLACE ! ' TV-PAGE CFA 'PAGE ! ' TV-EOL CFA '-EOL ! ;S ( CRT control functions : Infoton I-100 ) ( uncomment the arrow to select another terminal --> ) ." Infoton I-100 terminal " CR CR : INF-PLACE ( row column -- ) SWAP ESC 102 EMIT 32 + EMIT ( col) 32 + EMIT ( row) ; : INF-PAGE ( -- clear, home cursor ) 12 EMIT ; : INF-EOL ( n -- clear to end of line ) DROP ESC 75 EMIT ; ' INF-PLACE CFA 'PLACE ! ' INF-PAGE CFA 'PAGE ! ' INF-EOL CFA '-EOL ! ;S ( CRT control functions : Heath/Zenith-19 ) ( uncomment the arrow to select another terminal --> ) ." H-19 terminal " CR CR : H19-PLACE ( col row -- ) ESC 89 ( 'Y' ) EMIT 32 + EMIT ( col) 32 + EMIT ( row) ; : H19-PAGE ( -- clear, home cursor ) ESC 69 EMIT ; : H19-EOL ( n -- clear to end of line ) DROP ESC 75 EMIT ; ' H19-PLACE CFA 'PLACE ! ' H19-PAGE CFA 'PAGE ! ' H19-EOL CFA '-EOL ! ;S ( CRT control functions : Concept 108 ) ( uncomment the arrow to select another terminal --> ) ." Concept terminal " CR CR : HDS-PLACE ( col row -- ) ESC 97 ( 'a' ) EMIT 32 + EMIT ( row) 32 + EMIT ( col) ; : HDS-PAGE ( -- clear, home cursor ) 12 EMIT ; : HDS-EOL ( n -- clear to end of line ) DROP ESC 21 EMIT ; ' HDS-PLACE CFA 'PLACE ! ' HDS-PAGE CFA 'PAGE ! ' HDS-EOL CFA '-EOL ! ESC 85 EMIT ( set programmer mode ) ;S ( CRT control functions : IBM-PC ) ." IBM Personal Computer " CR CR : PC-PLACE ( col row -- ) 0 ROT ROT SWAP LOCATE ; : PC-EOL ( n -- clear to end of line ) C/L MOD C/L SWAP - SPACES ; ' PC-PLACE CFA 'PLACE ! ' CLS CFA 'PAGE ! ' PC-EOL CFA '-EOL ! ;S
